-- card: 3676 from stack: in.5 -- bmap block id: 4534 -- flags: 0000 -- background id: 3858 -- name: VolumePath ----- HyperTalk script ----- on hideObjects hide cd btn "Try It!" end hideObjects on showObjects show cd btn "Try It!" end showObjects -- part 6 (button) -- low flags: 00 -- high flags: A004 -- rect: left=60 top=177 right=213 bottom=191 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 8192 -- line height: 16 -- part name: Try it! ----- HyperTalk script ----- on mouseUp answer "You chose “" & VolumePath() & "”" end mouseUp -- part contents for background part 20 ----- text ----- VolumePath displays a modified Standard File dialog to let the user choose a volume. It returns the full path name of the chosen volume, or empty if the CANCEL button is chosen. The dialog window is centered in the HyperCard window, regardless of which monitor it is on. In addition to the standard Eject, Drive, Select, and Cancel buttons, the XFCN displays the amount of free space on a volume. As with all of our XCMDs and XFCNs, passing a single question mark (VolumeName("?") in this case) returns the syntax for the external. Passing two question marks (VolumeName("??")) or a single exclamation mark (VolumeName("!")) returns the copyright information. -- part contents for background part 38 ----- text ----- 50/50 -- part contents for background part 42 ----- text ----- { VolumeName() XFCN source listing} { This is an XFCN that brings up a custom standard file dialog to allow the user to select a volume.} { This source file is part of a stack containing all necessary source code and compiled versions of} { this XFCN as well as 2 other standard file XFCN's. Send requests for the stack to the applelink} { addresses below.} {} { This XFCN is not to be sold commercially or included within any commercial product} { without specific authorization from the authors and Apple Computer, Inc.} {} { Written by: Anup Murarka Eric Carlson } { ALINK: SKEPTIC ALINK: cyNic } { CIS: 76004,3356 } {} { We are part of the Support Tools Development Group, } { Apple Computer, Inc. } {} { please DO NOT contack Mac DTS for support of this code! } {} { please DO contact the authors for support of this code! } {} { Send comments, bug reports, requests to any of the above } { E-mail addresses or to:} {} { (one of us) } { Apple Computer, Inc. } { 900 E. Hamilton, Ave. } { Campbell, CA 95008 } { M/S 72-L } {} { Copyright: © 1989, 1990 by Apple Computer, Inc., all rights reserved. } {} { written by : Anup Murarka } { AppleLink : Skeptic } { modification history } { Date Initials Comments } { ---- ------ ------------------------------------------------------} { 11/29/89 ec&akm first written } { 8/14/90 ec recompiled with new libraries for Modal Dialog update bug } { & A/UX correct path construction. Changed version to 1.1 } {} unit dummyUnit; interface uses HyperXCMD; procedure main (paramPtr: XCmdPtr); implementation procedure VolumeName (paramPtr: XCmdPtr); FORWARD; procedure main (paramPtr: XCmdPtr); begin VolumeName(paramPtr); end; const kSFSaveDisk = $214; { Negative of current volume refnum [WORD] } kApplScratch = $00000A78; kCurDirStore = $398; { DirID of current directory [LONG] } DITLSizeDiff = 30; type DITLItem = record itmHndl: handle; itmRect: rect; itmType: SignedByte; itmData: SignedByte; { This is really only the length byte. Data follows of variable length} { itmData is followed by the actual data. See IM I-427} end; pDITLItem = ^DITLItem; hDITLItem = ^pDITLItem; ItemList = record dlgMaxIndex: integer; DITLItems: array[0..0] of DITLItem; end; pItemList = ^ItemList; hItemList = ^pItemList; integerPtr = ^integer; procedure reportToUser (paramPtr: XCmdPtr; msgStr: str255); {} { report something back to the user. } { the last parameter (optional) to an external may contain } { "noDialog" or "noDialog:GlobalName". GlobalName is the name } { of a HyperTalk global variable into which error messages will be } { placed. we've decided to use this approach to avoid confusing } { an error message with a valid result being returned from an XFCN. } {} var tempStr: str255; begin {check the last param to see if the user requested that} { we suppress the error dialog } ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr); UprString(tempStr, true); if pos('NODIALOG', tempStr) = 0 then { no special error handling specified, throw up a dialog and return the error message } begin SendCardMessage(paramPtr, concat('answer "', msgStr, '"')); paramPtr^.returnValue := PasToZero(paramPtr, msgStr); end else if (pos(':', tempStr) > 0) then { requested global AND noDialog so we fill in the global and return empty } begin tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr)); { get the name of the HC global to fill } SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr)); { and fill it } paramPtr^.returnValue := PasToZero(paramPtr, ''); { return empty } end else { requested noDialog only so we return the error condition as the result } paramPtr^.returnValue := PasToZero(paramPtr, msgStr); end; { procedure } function AskedForHelp (paramPtr: XCmdPtr; syntaxMsg: Str255; copyrightMsg: Str255): boolean; { check to see if the user sent a '?' or a '!' as } { the only parameter. if so we will respond with } { the calling syntax or the copyright/version info } { for this external } {} var firstStr: str255; begin askedForHelp := false; if paramPtr^.paramCount = 1 then begin ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr); { what is the first param? } if firstStr = '?' then begin reportToUser(paramPtr, syntaxMsg); askedForHelp := true end { asked for help } else if firstStr = '!' then begin reportToUser(paramPtr, copyRightMsg); askedForHelp := true end; { asked for copyright info } end; { one parameter passed } end; { function } function PathNameFromDirID (dirID: longint; vRefnum: integer; var fullPathName: str255): OSErr; { build up a full path name given a directory id and an vol ref num. this method isn't reccomended in general (see the } { various tech notes), but we use it in HC externals as HC uses exclusively full path names } var myCPB: CInfoPBRec; directoryName: str255; err: OSErr; begin fullPathName := ''; with myCPB do begin ioNamePtr := @directoryName; ioDrParID := DirId; end; repeat with myCPB do begin ioVRefNum := vRefNum; ioFDirIndex := -1; ioDrDirID := myCPB.ioDrParID; end; err := PBGetCatInfo(@myCPB, FALSE); directoryName := concat(directoryName, ':'); { pascal strings mustn't be longer than 255 chars, though a path name may, so check } if length(directoryName) + length(fullPathName) <= 255 then fullPathName := concat(directoryName, fullPathName) else myCPB.ioDrDirID := fsRtDirID; { lazy persons way to jump out } until (myCPB.ioDrDirID = 2); PathNameFromDirID := err; end; function StrToRect (paramPtr: XCMDPtr; rectStr: Str255): Rect; { convert a string, as from a callback or a passed parameter, to a rect } var where: Integer; tempRect: rect; begin where := POS(',', rectStr); tempRect.left := StrToNum(paramPtr, COPY(rectStr, 1, where - 1)); DELETE(rectStr, 1, where); where := POS(',', rectStr); tempRect.top := StrToNum(paramPtr, COPY(rectStr, 1, where - 1)); DELETE(rectStr, 1, where); where := POS(',', rectStr); tempRect.right := StrToNum(paramPtr, COPY(rectStr, 1, where - 1)); DELETE(rectStr, 1, where); tempRect.bottom := StrToNum(ParamPtr, rectStr); strToRect := tempRect; end; function HCWindowRect (paramPtr: XCMDPtr): rect; { the rect of HC's card window, in GLOBAL coordinates } var theResult: Handle; rectStr: str255; theLength: INTEGER; begin rectStr := 'the rect of card window'; theResult := EvalExpr(paramPtr, rectStr); if (theResult <> nil) and (paramPtr^.result = noErr) then ZeroToPas(paramPtr, theResult^, rectStr) else rectStr := ''; if (theResult <> nil) then DisposHandle(theResult); HCWindowRect := StrToRect(paramPtr, rectStr); end; function GetScreenSize: rect; { we don't have access to quick draw globals, as they lie in HC's global space, but we can } { get the monitor size indirectly by checking the portBits field of the window manager port } { MacRevealed vol 3, pg 20 } var deskPort: GrafPtr; tempRect: rect; begin GetWMgrPort(deskPort); { grab a pointer to the window manager port } if deskPort = nil then begin setRect(tempRect, 0, 0, 512, 342); GetScreenSize := tempRect; end else GetScreenSize := deskPort^.portBits.bounds; end; function monitorRect (aPoint: point): rect; { given a point, return the rect of the monitor that contains it.} const SysEnvVersion = 2; var currGDevice: GDHandle; gotTheMonitor: boolean; tempRect: rect; theSysEnv: SysEnvRec; envErr: OSErr; begin currGDevice := nil; envErr := SysEnvirons(SysEnvVersion, theSysEnv); {SysEnvirons Version is a constant in the interface section of this file} if theSysEnv.hasColorQD then { only proceed if we have color QD } begin currGDevice := GetDeviceList; gotTheMonitor := false; { haven't found the monitor yet } while (currGDevice <> nil) and not (gotTheMonitor) do { we assume that the point is in one of the graphic devices } begin if PtInRect(aPoint, currGDevice^^.gdRect) then begin monitorRect := currGDevice^^.gdRect; gotTheMonitor := true; end else { get the next device in the list } currGDevice := currGDevice^^.gdNextGD; end; if currGDevice = nil then begin setRect(tempRect, 0, 0, 0, 0); monitorRect := tempRect; end; end else {No Color QD} begin tempRect := GetScreenSize; if PtInRect(aPoint, tempRect) then monitorRect := tempRect else begin setRect(tempRect, 0, 0, 0, 0); monitorRect := tempRect; end; end; end; function CenterInHCWindow (paramPtr: XCMDPtr; windowRect: rect): point; var where: point; window, screen, tempRect: rect; h, v: integer; begin window := HCWindowRect(paramPtr); { the rect of card the window } screen := monitorRect(window.topLeft); { check to see the rect of the monitor containing the upper right corner of the card window } setRect(tempRect, 0, 0, 0, 0); if EqualRect(screen, tempRect) then { if '0,0,0,0' comes back then the upper right is off screen, check the upper left } begin setPt(where, window.right, window.top); screen := monitorRect(where); end; OffsetRect(windowRect, window.left - windowRect.left, window.top - windowRect.top); { zero the dlog rect onto the card window } h := ((window.right - window.left) - (windowRect.right - windowRect.left)) div 2; v := ((window.bottom - window.top) - (windowRect.bottom - windowRect.top)) div 2; OffSetRect(windowRect, h, v); { although it isn't possible to have BOTH upper corners off screen, check for an error. } { if we find one, use the default monitor rect } if EqualRect(screen, tempRect) then screen := GetScreenSize; { now center the rect in the card window } if not (PtInRect(windowRect.topLeft, screen) and PtInRect(windowRect.botRight, screen)) then begin { make sure the dlog rect is fully visible on the screen } if windowRect.top < screen.top then OffSetRect(windowRect, 0, screen.top - windowRect.top + 10); if windowRect.bottom > screen.bottom then OffSetRect(windowRect, 0, screen.bottom - windowRect.bottom - 10); if windowRect.left < screen.left then OffSetRect(windowRect, screen.left - windowRect.left + 10, 0); if windowRect.right > screen.right then OffSetRect(windowRect, screen.right - windowRect.right - 10, 0); end; SetPt(where, windowRect.left, windowRect.top); CenterInHCWindow := where; end; function unSignedByte (SB: signedByte): integer; type twoSBAreAnInt = record case integer of 0: ( sbArray: array[0..1] of SignedByte ); 1: ( Int: integer ); end; var tempInt: twoSBAreAnInt; begin tempInt.Int := 0; tempInt.sbArray[1] := SB; unSignedByte := tempInt.int; end; function insertCommas (theNumber: str255): str255; { Procedure to insert commas every 3 numeric digits} var count, group: integer; begin group := 0; for count := length(theNumber) downto 1 do begin group := group + 1; if (group <> 3) or (count = 1) then cycle; insert(',', theNumber, count); group := 0; end; insertCommas := theNumber; end; procedure drawFreeSpace (theDialog: DialogPtr); { draw the amount of free space into the dialog, just above item #5, the eject button } var thePort: GrafPtr; oldFont, oldSize: integer; freeSpace: longint; freeStr: str255; PB: ParamBlockRec; strWidth: integer; volInfoErr: OSerr; eraseArea: rect; itemType, left: integer; itemHndl: handle; itemRect: rect; begin GetPort(thePort); if thePort <> nil then begin PB.iovRefNum := -(integerPtr(kSFSaveDisk)^); { grab the VRefNum directly from lo mem} PB.ioVolIndex := 0; { use vRefNum only } PB.ioNamePtr := @freeStr; { VERY IMPORTANT! Tell PBGetVInfo where to } volInfoErr := PBGetVInfo(@PB, false); { put the vol name, even though we don't use it } if volInfoErr = noErr then begin FreeSpace := (PB.ioVAlBlkSiz * PB.ioVFrBlk) div 1024; { Calc the free size} NumToString(FreeSpace, FreeStr); FreeStr := insertCommas(FreeStr); end else begin FreeStr := '????'; { If an error occured, show question marks} end; FreeStr := concat(FreeStr, 'k free'); oldFont := thePort^.txFont; { remember the old font } oldSize := thePort^.txSize; { and the size } TextFont(3); { set text to geneva } TextSize(9); { 9 point } GetDItem(theDialog, 5, itemType, itemHndl, itemRect); { Get the coordinates of the Eject button} with itemRect do setRect(eraseArea, itemRect.left - 5, itemRect.top - 11, itemRect.right + 5, itemRect.top); eraseRect(eraseArea); strWidth := StringWidth(FreeStr); left := ((itemRect.right - itemRect.left) div 2) + itemRect.left; MoveTo(left - (strWidth div 2), itemRect.top - 2); { move the pen} DrawString(FreeStr); { show em how much free space they have... } TextFont(oldFont); { set font to the original } TextSize(oldSize); { and the size } end; end; function getVolDlgHook (item: Integer; theDialog: DialogPtr): Integer; var itemType: integer; itemHndl: handle; itemRect: rect; begin getVolDlgHook := item; case item of -1: begin { Change the name of the open button to 'Select'} GetDItem(theDialog, getOpen, itemType, itemHndl, itemRect); SetCTitle(controlHandle(itemHndl), 'Select'); end; 103: getVolDlgHook := 1; { Convert the open directory event to quit SFGetFile} end; end; function getVolFileFilter (PB: ParamBlockRec): boolean; begin { 'show' all files so that at least a desktop file will be shown offscreen and the 'Open' button is enabled} getVolFileFilter := false; end; function getStdDlgFilter (theDialog: DialogPtr; var theEvent: eventRecord; var itemHit: integer): boolean; { A dialog filter is usually unneeded for simple std. file stuff. We use one here so that we can draw the} { freespace for the current volume. The string is drawn not put as a static text item so that we can use a} { different font for the string. Because we draw on an update event we must compensate for std file's bug} { which confuses update events meant for windows behind it. Thus if we see an update event for someone } { elses window change the event to a NULL and tell ModalDialog that we've handled it. } begin getStdDlgFilter := false; { Pass Standard File package handle all events} case theEvent.what of updateEvt: if DialogPtr(theEvent.message) <> theDialog then begin itemHit := 100; { change the event to a NULL } getStdDlgFilter := true; { tell Standard File package that we have handled it} end else drawFreeSpace(theDialog); { update our free space indicator } otherwise { a do nothing case} end; {case} end; {getFileDlgFilter} procedure SFGetVolume (pt: point; var reply: SFReply); { this is the main routine. It takes a different approach to customizing SFGetFile} type DITLItem = record { First, a single item} itmHndl: Handle; { Handle or procPtr for this item} itmRect: Rect; { Display rectangle for this item} itmType: integer; { Item type for this item is in hi byte. length of next field is in lo byte} { itmData: itmDataLength bytes must be even} end; {DITLItem} pDITLItem = ^DITLItem; hDITLItem = ^pDITLItem; ItemList = record { Then, the list of items} dlgMaxIndex: Integer; { Number of items minus 1} DITLItems: array[0..0] of DITLItem; { Array of items} end; { ItemList} pItemList = ^ItemList; hItemList = ^pItemList; var typeList: SFTypeList; dlogHndl: DialogTHndl; ditlID: integer; dlogSize: rect; ditlHndl: hItemList; ItemInDITL: pDITLItem; savedApplScratch: longint; oldPort: grafPtr; function EvenByte (value: integer): integer; { returns the smallest even number equal to or greater than value} var tempInt: integer; begin tempInt := bitAND(value, $00FF); EvenByte := tempInt + (tempInt mod 2); end; begin { We want a very small dialog with no file list item. The problem is that if we move items around} { with a regular DialogHook routine, the useritems (the file list & the volume name) are already} { initialized and their procedures draw where the items ORIGINALLY were before we moved them!} { Sooooo, we load the DITL resource and lock it in memory. We then move everything around in} { the DITL before we ever call the SFPGetFile toolbox call.} { First load the DLOG resource and find out which DITL we are supposed to load} dlogHndl := DialogTHndl(GetResource('DLOG', getDlgID)); if dlogHndl = nil then begin reply.good := false; {If the DLOG could not be loaded, fail out} exit(SFGetVolume); end; MoveHHI(handle(dlogHndl)); HNoPurge(handle(dlogHndl)); HLock(handle(dlogHndl)); dlogsize := dlogHndl^^.boundsRect; { size the window to 110 horizontally and 180 vertically} setRect(dlogHndl^^.boundsRect, dlogsize.left, dlogsize.top, dlogsize.left + 109, dlogsize.top + 179); ditlID := dlogHndl^^.itemsID; HUnLock(handle(dlogHndl)); { Now get the DITL} ditlHndl := hItemList(GetResource('DITL', ditlID)); if ditlHndl = nil then begin { Since we could not load the resource, abort} reply.good := false; HPurge(handle(dlogHndl)); DetachResource(handle(dlogHndl)); DisposHandle(handle(dlogHndl)); exit(SFGetVolume); end; MoveHHI(handle(ditlHndl)); HNoPurge(handle(ditlHndl)); HLock(handle(ditlHndl)); { Now move everybody around. Use the routine at least once to get an idea of what we are doing here} { Item 1 is the Open button} ItemInDITL := pDITLItem(ORD4(ditlHndl^) + 2); setRect(ItemInDITL^.itmRect, 15, 109, 95, 127); { Item 2 is an invisible, unused button} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); { Item 3 is the Cancel button} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 15, 134, 95, 152); { Item 4 is the UserItem for DiskName} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 1, 17, 112, 38); { Item 5 is the Eject button} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 15, 51, 95, 69); { Item 6 is the Drive button} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 15, 76, 95, 94); { Item 7 is the userItem for the file name list} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 112, 39, 330, 185); { Item 8 is the user item for the scroll bar} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 329, 39, 351, 185); { Item 9 is the useritem for the dotted line} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); setRect(ItemInDITL^.itmRect, 10, 101, 100, 102); { Item 10 is the invisible, unused statText} ItemInDITL := pDITLItem(ORD4(ItemInDITL) + 14 + EvenByte(ItemInDITL^.itmType)); HUnLock(handle(ditlhndl)); GetPort(oldPort); { Save anything that we might change} { NOW make the toolbox call} SFPGetFile(pt, '', @getVolFileFilter, -1, TypeList, @getVolDlgHook, reply, getdlgID, @getStdDlgFilter); SetPort(oldPort); { and restore anything that we might change} { Since this routine selects volumes, pass the root dir id back. reply.vRefNum is already correct} reply.fType := ResType(longint(fsRtDirID)); { Now clean up the mess you've made!!!} { (Otherwise the next call to SFGetFile will be REALLY interesting!)} HPurge(handle(dlogHndl)); DetachResource(handle(dlogHndl)); DisposHandle(handle(dlogHndl)); HPurge(handle(ditlHndl)); DetachResource(handle(ditlHndl)); DisposHandle(handle(ditlHndl)); end; procedure VolumeName (paramPtr: XCMDPtr); var reply: SFReply; pathName: str255; prompt: str255; thePt: point; tempRect: rect; err: OSErr; begin { First check to see if the user requested syntax or copyright information} { If they did, we exit the XFCN. The subroutine takes care of returning the proper string} if askedForHelp(paramPtr, 'VolumePath()', 'v1.1, ©1989 Apple Computer, Inc. by Anup Murarka & Eric Carlson') then exit(VolumeName); {110 by 180 are the dimensions of our custom dialog box} SetRect(tempRect, 0, 0, 110, 180); thePt := CenterInHCWindow(paramPtr, tempRect); { This glue routine centers our dialog} SFGetVolume(thePt, reply); { This routine does the real work. Found in CustomSF.p} if reply.good then { If a volume was selected, return the pathname} begin err := PathNameFromDirID(longint(reply.fType), reply.vRefNum, pathName); paramPtr^.returnValue := PasToZero(paramPtr, pathName); end; end; end.